$LINESIZE: 132
$PAGESIZE: 61
$STORAGE: 2
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                          M I C R O S A F E                           C
C                Structural Analysis by Finite Elements                C
C                     Module : SAFESOLV,  2nd Part                     C
C                            Version : 2-D                             C
C                                                                      C
C         COPYRIGHT (C) by MICROSTRESS Corporation - 1985,1986         C
C                         ALL RIGHTS RESERVED                          C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE parsfn (flspec,ddrive,fldriv,driven,flpath,flname,
     +                   flextn)
C
C  Parse a file specification and get drive, path, name and extension
C
      IMPLICIT INTEGER (a-z)
      CHARACTER fldriv*6,flpath*64,flname*9,flextn*5,flspec*78,colon*2,
     +          bslash*2,period*2
C
C  Initialization.
C
      call setstr (78,flspec)
      call pakstr (flspec)
      call upcstr (flspec)
      fldriv='      '
      call setstr (6,fldriv)
      flpath='
     +         '
      call setstr (64,flpath)
      flname='         '
      call setstr (9,flname)
      flextn='     '
      call setstr (5,flextn)
      colon=': '
      call setstr (2,colon)
      bslash='\ '
      call setstr (2,bslash)
      period='. '
      call setstr (2,period)
C
C  Determine the drive specification
C
      locatn=locstr (1,flspec,colon)
      if (locatn .eq. 0) then
          driven=ddrive+1
      else
          call movstr (fldriv,1,1,flspec,1,locatn)
          driven=ascstr (locatn-1,flspec)-64
      endif
C
C  Determine the path specification
C
      firstc=locatn+1
      lastoc=locatn
   10 locatn=locstr (lastoc+1,flspec,bslash)
      if (locatn .ne. 0) then
          lastoc=locatn
          goto 10
      else
          call movstr (flpath,1,1,flspec,firstc,lastoc-firstc+1)
      endif
C
C  Determine the extension specification
C
      length=lenstr(flspec)
      locatn=locstr (lastoc+1,flspec,period)
      if (locatn .ne. 0) then
          call movstr (flextn,1,1,flspec,locatn,length-locatn+1)
      else
          locatn=length+1
      endif
C
C  Determine the name specification
C
      call movstr (flname,1,1,flspec,lastoc+1,locatn-lastoc-1)
C
C  Pack the return strings
C
      call pakstr (fldriv)
      call pakstr (flpath)
      call pakstr (flname)
      call pakstr (flextn)
      RETURN
      END
$PAGE
      SUBROUTINE triasemb (i,j,k,th,eyoung,pratio)
C
C  Assemble stiffness matrix for triangular plate
C
      DOUBLE PRECISION th,diffnc(2,4),ftcons(9),eyoung,pratio
      common /coordi/ coonod(2,401)
      diffnc(1,2)=coonod(1,J)-coonod(1,I)
      diffnc(2,2)=coonod(2,J)-coonod(2,I)
      diffnc(1,3)=coonod(1,K)-coonod(1,J)
      diffnc(2,3)=coonod(2,K)-coonod(2,J)
      diffnc(1,1)=coonod(1,I)-coonod(1,K)
      diffnc(2,1)=coonod(2,I)-coonod(2,K)
      ftcons(6)=diffnc(2,3)*diffnc(1,2)-diffnc(1,3)*diffnc(2,2)
      ftcons(1)=eyoung*TH/(4*ftcons(6))
      ftcons(8)=ftcons(1)/(1-pratio)
      ftcons(7)=ftcons(1)/(1+pratio)
      ftcons(1)=ftcons(7)*
     +          (diffnc(1,3)*diffnc(1,3)+diffnc(2,3)*diffnc(2,3))
      ftcons(2)=ftcons(7)*
     +          (diffnc(1,1)*diffnc(1,1)+diffnc(2,1)*diffnc(2,1))
      ftcons(3)=ftcons(7)*
     +          (diffnc(1,3)*diffnc(1,2)+diffnc(2,3)*diffnc(2,2))
      ftcons(4)=ftcons(7)*ftcons(6)
      ftcons(5)=ftcons(7)*
     +          (diffnc(1,2)*diffnc(1,2)+diffnc(2,2)*diffnc(2,2))
      I1=3*I-2
      J1=3*J-2
      K1=3*K-2
      CALL assemble (i1,i1,ftcons(1)+ftcons(8)*diffnc(2,3)*diffnc(2,3),
     +               -ftcons(8)*diffnc(1,3)*diffnc(2,3),0.)
      CALL assemble (i1,j1,-ftcons(1)-ftcons(3)+
     +               ftcons(8)*diffnc(2,3)*diffnc(2,1),
     +               -ftcons(4)-ftcons(8)*diffnc(2,3)*diffnc(1,1),0.)
      CALL assemble (i1,k1,ftcons(3)+ftcons(8)*diffnc(2,2)*diffnc(2,3),
     +               ftcons(4)-ftcons(8)*diffnc(2,3)*diffnc(1,2),0.)
      CALL assemble (i1+1,i1+1,ftcons(1)+
     +               ftcons(8)*diffnc(1,3)*diffnc(1,3),0.,0.)
      CALL assemble (i1+1,J1,ftcons(4)-ftcons(8)*
     +               diffnc(2,1)*diffnc(1,3),-ftcons(1)-ftcons(3)+
     +               ftcons(8)*diffnc(1,1)*diffnc(1,3),0.)
      CALL assemble (i1+1,K1,
     +               -ftcons(4)-ftcons(8)*diffnc(2,2)*diffnc(1,3),
     +               ftcons(3)+ftcons(8)*diffnc(1,2)*diffnc(1,3),0.)
      CALL assemble (J1,j1,ftcons(2)+ftcons(8)*diffnc(2,1)*diffnc(2,1),
     +               -ftcons(8)*diffnc(2,1)*diffnc(1,1),0.)
      CALL assemble (j1,K1,-ftcons(3)-ftcons(5)+
     +               ftcons(8)*diffnc(2,1)*diffnc(2,2),
     +               -ftcons(4)-ftcons(8)*diffnc(2,1)*diffnc(1,2),0.)
      CALL assemble (j1+1,j1+1,
     +               ftcons(2)+ftcons(8)*diffnc(1,1)*diffnc(1,1),0.,0.)
      CALL assemble (j1+1,k1,ftcons(4)-
     +               ftcons(8)*diffnc(1,1)*diffnc(2,2),-ftcons(3)-
     +               ftcons(5)+ftcons(8)*diffnc(1,1)*diffnc(1,2),0.)
      CALL assemble (K1,K1,ftcons(5)+ftcons(8)*diffnc(2,2)*diffnc(2,2),
     +               -ftcons(8)*diffnc(1,2)*diffnc(2,2),0.)
      CALL assemble (k1+1,k1+1,
     +               ftcons(5)+ftcons(8)*diffnc(1,2)*diffnc(1,2),0.,0.)
      RETURN
      END
$PAGE
      SUBROUTINE assemble (irow,icol,add1,add2,add3)
C
C  Assemble the stiffness matrix
C
      DOUBLE PRECISION stmtrx,stmqcn,add(3),add1,add2,add3
      INTEGER longi*4
      COMMON /global/ numdof,stmqcn(2,2)
      common /sizebw/ malhbw
      COMMON /aaaaaa/ stmtrx(8200)
      add(1)=add1
      add(2)=add2
      add(3)=add3
      do 10 i=1,3
      if (add(i) .ne. 0.) then
          ic=icol+i-1
          if ((irow .le. numdof) .and. (ic .le. numdof)) then
              longi=ic+irow-1-malhbw
              if (irow .ge. ic) then
                  longi=longi+malhbw*ic
              else
                  longi=longi+malhbw*irow
              endif
              stmtrx(longi)=stmtrx(longi)+add(i)
          else
              longi=ic+irow-2-numdof
              if (irow .gt. numdof) then
                  if (ic .le. numdof) then
                      longi=longi+ic*(malhbw+1)
                      stmtrx(longi)=stmtrx(longi)+add(i)
                  else
                      ir=irow-numdof
                      icband=ic-numdof
                      stmqcn(ir,icband)=stmqcn(ir,icband)+add(i)
                      stmqcn(icband,ir)=stmqcn(ir,icband)
                  endif
              else
                  longi=longi+irow*(malhbw+1)
                  stmtrx(longi)=stmtrx(longi)+add(i)
              endif
          endif
      ENDIF
   10 continue
      RETURN
      END
$PAGE
      SUBROUTINE triloads (inp1,inp2,inp3,th,eyoung,pratio,lpl,nodepl)
C
C  Calculate forces and stresses in triangular plate
C
      DOUBLE PRECISION disdof,corfor,eyoung,pratio,th,
     +                 diffnc(2,4),ftcons(9)
      DIMENSION inp(3),corfor(2,3),nodepl(4,500)
      INTEGER previd
      common /coordi/ coonod(2,401)
      COMMON /plates/ disdof(1203),pltecf(2,4),plstrs(3,500),
     +                  reafor(3,400),pstnor(3,400),pstacc(3,400)
      previd(k,l)=MOD(k+l-2,l)+1
      nextid(k,l)=MOD(k,l)+1
      inp(1)=inp1
      inp(2)=inp2
      inp(3)=inp3
      I=nodepl(inp(1),LPL)
      J=nodepl(inp(2),LPL)
      IF (inp(3) .lt. 0) THEN
          K=-inp(3)
          nan=2
      ELSE
          K=nodepl(inp(3),LPL)
          nan=3
      ENDIF
      I1=3*I-2
      J1=3*J-2
      K1=3*K-2
      diffnc(1,2)=coonod(1,J)-coonod(1,I)
      diffnc(2,2)=coonod(2,J)-coonod(2,I)
      diffnc(1,3)=coonod(1,K)-coonod(1,J)
      diffnc(2,3)=coonod(2,K)-coonod(2,J)
      diffnc(1,1)=coonod(1,I)-coonod(1,K)
      diffnc(2,1)=coonod(2,I)-coonod(2,K)
      ftcons(4)=eyoung/((1+pratio)*(diffnc(1,1)*diffnc(2,2)-
     +          diffnc(1,2)*diffnc(2,1)))
      ftcons(5)=diffnc(2,3)*disdof(I1)+diffnc(2,1)*disdof(J1)+
     +          diffnc(2,2)*disdof(K1)
      ftcons(6)=diffnc(1,3)*disdof(I1+1)+diffnc(1,1)*disdof(J1+1)+
     +          diffnc(1,2)*disdof(K1+1)
      ftcons(1)=(pratio*ftcons(6)-ftcons(5))*ftcons(4)/(1-pratio)
      ftcons(2)=(ftcons(6)-pratio*ftcons(5))*ftcons(4)/(1-pratio)
      ftcons(3)=(diffnc(1,3)*disdof(I1)-diffnc(2,3)*disdof(I1+1)+
     +        diffnc(1,1)*disdof(J1)-diffnc(2,1)*disdof(J1+1)+
     +        diffnc(1,2)*disdof(K1)-diffnc(2,2)*disdof(K1+1))*
     +        ftcons(4)/2
      DO 20 LL=1,NAN
      INDX=nodepl(inp(LL),LPL)
      ftcons(7)=ABS(diffnc(2,nextid(LL,3))-diffnc(2,LL))/
     +          (ABS(diffnc(1,nextid(LL,3))-diffnc(1,LL))+
     +          ABS(diffnc(2,nextid(LL,3))-diffnc(2,LL)))
      DO 10 L=1,2
      corfor(L,LL)=TH*.5*(diffnc(1,previd(LL,3))*ftcons(4-L)-
     +    diffnc(2,previd(LL,3))*ftcons(2*L-1))
      pltecf(L,inp(LL))=pltecf(L,inp(LL))+corfor(L,LL)
      ftcons(7)=1-ftcons(7)
      reafor(L,INDX)=reafor(L,INDX)+corfor(L,LL)
      pstnor(L,INDX)=pstnor(L,INDX)+ftcons(7)
      pstacc(L,INDX)=pstacc(L,INDX)+ftcons(7)*ftcons(L)
   10 CONTINUE
      pstacc(3,INDX)=pstacc(3,INDX)+ftcons(3)
      pstnor(3,INDX)=pstnor(3,INDX)+1
      plstrs(LL,LPL)=plstrs(LL,LPL)+ftcons(LL)
   20 CONTINUE
      IF (nan .EQ. 2) plstrs(3,LPL)=plstrs(3,LPL)+ftcons(3)
      RETURN
      END
$PAGE
      SUBROUTINE opnfil (ierror)
C
C  Open a file for output with verification
C
      LOGICAL ffound
      CHARACTER inpfil*78,outfil*78,prompt*55,intgst*25
      common /filenm/ inpfil,outfil
      inquire (FILE=outfil,EXIST=ffound)
      if (.not.(ffound)) then
          call setstr (78,outfil)
          call pakstr (outfil)
          length=lenstr(outfil)+1
          call expstr (outfil)
          call resstr (outfil)
          call setstr (length,outfil)
          call chopwr (outfil,ierror)
          if (ierror .ne. 0) then
              call resstr (outfil)
              length=length-1
              call wrfstr (float(length),intgst)
              length=lenstr (intgst)
              prompt='('' ERROR : File "'',a  ,''" cannot be open. Try a
     +gain.'') '
              call setstr (55,prompt)
              call movstr (prompt,21,0,intgst,1,length)
              call resstr (prompt)
              write (*,prompt) outfil
              return
          endif
          call resstr (outfil)
      endif
      OPEN (2,FILE=outfil,STATUS='new')
      ierror=0
      return
      END
$PAGE
      SUBROUTINE diskroom (nbytes)
C
C  Update count of characters in output file to avoid disk full errors.
C
      INTEGER frespc*4,odrive,scrflg,asciic
      COMMON /dskrom/ scrflg,odrive
C
      if (nbytes .eq. 0) then
          call dskspc (odrive,frespc)
          frespc=frespc-1
      else
C
   20     frespc=frespc-nbytes
C
          if (frespc .lt. 0) then
              close (2)
              asciic=odrive+64
              write (*,30)
   30         format (//' ERROR : Output file disk is full.')
   32         write (*,35) char(asciic)
   35         format (' Change the disk in drive ',a1,
     +                ' and press any key to continue.')
              call confrm
              if (scrflg .eq. 0) write (*,40)
   40         format (1x\)
              call opnfil (ierror)
              if (ierror .ne. 0) goto 32
              call dskspc (odrive,frespc)
              frespc=frespc-1
              goto 20
          endif
      endif
      return
      end
$PAGE
      SUBROUTINE verify (idline,entry,ierror,maxban,youngm)
C
C  Verify input data
C
      implicit integer (a-z)
      real coonod,entry,boulow,bouhig,ftcons,fltstr,youngm
      CHARACTER buffer*126,slash*2,space*2,stcons*25,line*79,inpfil*78,
     +          outfil*78,period*2,grafch*1,tabchr*2,typpar*14,ordinl*8,
     +          errmsg*50,lintyp*16,linent*30,txtpar*49,messge*80
      DIMENSION numpar(14),itypar(14,8),boulow(14,8),bouhig(14,8),
     +          itxtpr(14,8),typpar(2),errmsg(9),lintyp(14),linent(14),
     +          ordinl(8),txtpar(40),messge(3),entry(8),youngm(20)
      common /coordi/ coonod(2,401)
      common /sizebw/ malhbw
      common /filenm/ inpfil,outfil
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                         ARRAY INITIALIZATION                         C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DATA numpar /1,1,1,1,1,1,1,3,3,8,7,5,4,3/
      DATA itypar /14*1,9*2,3*1,2,1,9*2,3*1,2,1,10*2,1,3*2,10*2,1,3*2,
     +           10*1,4*2,10*2,4*1,14*2/
      DATA boulow /1.,6*0.,7*1.,8*-10E18,0.,3*1.,-10E18,1.,8*-10E18,
     +             0.,3*1.,2*-10E18,10*0.,1.,0.,2*-10E18,14*0.,10*1.,
     +             4*0.,10*-10E18,4*1.,14*-10E18/
      DATA bouhig /400.,20.,600.,500.,60.,100.,300.,7*0.,13*10E18,3.,
     +             14*10E18,14*10E18,14*10E18,14*10E18,14*10E18,
     +             14*10E18/
      DATA typpar /' - an integer ',' - a number   '/
      DATA errmsg /'UNEXPECTED END OF INPUT FILE.                     '
     +            ,'INPUT LINE CONTAINS LESS DATA THAN REQUIRED.      '
     +            ,'ENTRY CANNOT BE INTERPRETED AS A NUMBER.          '
     +            ,'INCOMPATIBLE TYPE OF NUMERIC ENTRY IN INPUT LINE. '
     +            ,'ENTRY IS OUTSIDE THE PROPER NUMERIC BOUNDS.       '
     +            ,'THE STIFFNESS MATRIX BAND IS TOO WIDE.            '
     +            ,'ELEMENT WITH TWO IDENTICAL NODES.                 '
     +            ,'ELEMENT NODES SHARE THE SAME PHYSICAL LOCATION.   '
     +            ,'DUPLICATED SPECIFICATIONS IN INPUT FILE.          '/
      DATA lintyp /'model size      '
     +            ,'model size      '
     +            ,'model size      '
     +            ,'model size      '
     +            ,'model size      '
     +            ,'model size      '
     +            ,'model size      '
     +            ,'node            '
     +            ,'material        '
     +            ,'beam            '
     +            ,'plate           '
     +            ,'fastener        '
     +            ,'nodal loading   '
     +            ,'nodal restraint '/
      DATA linent /'                              '
     +            ,'                              '
     +            ,'                              '
     +            ,'                              '
     +            ,'                              '
     +            ,'                              '
     +            ,'                              '
     +            ,'coordinates of node           '
     +            ,'properties of material code   '
     +            ,'properties of beam            '
     +            ,'properties of plate           '
     +            ,'properties of fastener        '
     +            ,'applied loads to node         '
     +            ,'imposed displacements to node '/
      DATA ordinl /'first   '
     +            ,'second  '
     +            ,'third   '
     +            ,'fourth  '
     +            ,'fifth   '
     +            ,'sixth   '
     +            ,'seventh '
     +            ,'eighth  '/
      DATA itxtpr /1,2,3,4,5,6,7,8,11,14,22,29,34,38,
     +             0,0,0,0,0,0,0,9,12,15,23,30,35,39,
     +             0,0,0,0,0,0,0,10,13,16,24,31,36,40,
     +             0,0,0,0,0,0,0,0,0,17,25,32,37,0,
     +             0,0,0,0,0,0,0,0,0,18,26,33,0,0,
     +             0,0,0,0,0,0,0,0,0,19,27,0,0,0,
     +             0,0,0,0,0,0,0,0,0,20,28,0,0,0,
     +             0,0,0,0,0,0,0,0,0,21,0,0,0,0/
      stcons='                         '
      line='
     +                   '
      slash='/ '
      call setstr(2,slash)
      space='  '
      call setstr(2,space)
      grafch=char(9)
      tabchr='  '
      call setstr(2,tabchr)
      call movstr(tabchr,1,0,grafch,1,1)
      chrerr=0
      idparm=1
      locatn=1
      if (idline .eq. 1) linumb=0
   10 linumb=linumb+1
      ierror=1
      READ (1,20,END=70,ERR=1000) buffer
   20 FORMAT (A126)
      call setstr(126,buffer)
      ierror=0
      ENDSEP=locstr(1,buffer,slash)
      IF (ENDSEP .eq. 0) goto 10
      call endstr (endsep+1,buffer)
   25 itcons=locstr(locatn,buffer,tabchr)
      if (itcons .ne. 0) then
          call movstr (buffer,itcons,0,space,1,1)
          locatn=itcons+1
          goto 25
      endif
      locatn=1
   30 IF (locatn .ge. ENDSEP) THEN
          chrerr=ENDSEP
          ierror=2
          GOTO 70
      endif
      seprtr=locstr(locatn,buffer,space)
      IF (seprtr .eq. locatn) THEN
          locatn=locatn+1
          GOTO 30
      endif
      IF ((seprtr .eq. 0) .OR. (seprtr .gt. ENDSEP)) seprtr=ENDSEP
      ierror=0
      decpop=0
      EXPFLG=0
      EXPSGN=0
      seploc=seprtr-locatn
      do 50 positn=1,SEPLOC
      index=locatn+positn-1
      asciic=ascstr(index,buffer)
      IF ((asciic .gt. 47) .AND. (asciic .lt. 58)) goto 40
      IF ((positn .eq. 1) .AND. ((asciic .eq. 43) .OR.
     +   (asciic .eq. 45))) goto 40
      IF ((asciic .eq. 46) .AND. (decpop .eq. 0)) THEN
          decpop=locatn+positn-1
          GOTO 40
      endif
      IF (((asciic .eq. 68) .OR. (asciic .eq. 69) .OR. (asciic .eq. 100)
     +  .OR. (asciic .eq. 101)) .AND. (EXPFLG .eq. 0)) THEN
          EXPFLG=locatn+positn
          GOTO 40
      endif
      IF (((asciic .eq. 43) .OR. (asciic .eq. 45)) .AND. (EXPFLG .ne. 0)
     +  .AND. (EXPSGN .eq. 0)) THEN
          EXPSGN=locatn+positn
          if (asciic .gt. 43) expsgn=-expsgn
          GOTO 40
      endif
      ierror=3
      chrerr=locatn+positn-1
      goto 60
   40 continue
   50 continue
   60 continue
      IF (ierror .eq. 3) goto 70
      call setstr(25,stcons)
      call movstr(stcons,1,1,buffer,locatn,SEPLOC)
      call resstr(stcons)
      ftcons=fltstr(stcons)
      IF ((ftcons .lt. boulow(idline,idparm)) .OR.
     +  (ftcons .gt. bouhig(idline,idparm))) THEN
          ierror=5
          chrerr=locatn
          GOTO 70
      endif
      IF ((itypar(idline,idparm) .eq. 1) .and.
     +  (ftcons .ne. float(int(ftcons)))) then
          ierror=4
          IF (decpop .ne. 0) THEN
              chrerr=decpop
              GOTO 70
          ELSE
              IF (EXPSGN .lt. 0) THEN
                  chrerr=-EXPSGN
                  GOTO 70
              ELSE
                  chrerr=locatn
                  GOTO 70
              endif
          endif
      endif
      entry(idparm)=ftcons
      if ((idparm .eq. 1) .and. (idline .gt. 7) .and. (idline .lt. 14))
     +    then
          itcons=INT(ftcons)
          CALL CHKDUP (itcons,ierror)
          IF (ierror .ne. 0) THEN
              ierror=9
              chrerr=locatn
              goto 70
          endif
      else
          if ((idparm .eq. 2) .and. (idline .eq. 14)) then
              itcons=INT(3*entry(1)+ftcons-3)
              CALL CHKDUP (itcons,ierror)
              IF (ierror .ne. 0) THEN
                  ierror=9
                  chrerr=locatn
                  goto 70
              endif
          endif
      endif
      locatn=seprtr+1
      idparm=idparm+1
      IF (idparm .gt. numpar(idline)) THEN
          if (idline .lt. 6) bouhig(idline+7,1)=entry(1)
          if (idline .eq. 1) then
              bouhig(10,2)=entry(1)
              bouhig(10,3)=entry(1)
              bouhig(11,2)=entry(1)
              bouhig(11,3)=entry(1)
              bouhig(11,4)=entry(1)
              bouhig(11,5)=entry(1)
              bouhig(12,2)=entry(1)
              bouhig(12,3)=entry(1)
              bouhig(13,1)=entry(1)
              bouhig(14,1)=entry(1)
          endif
          if (idline .eq. 2) then
              bouhig(10,6)=entry(1)
              bouhig(11,7)=entry(1)
          endif
          if (((idline .eq. 10) .and. (entry(4) .ne. 0.) .and.
     +         (youngm(int(entry(6))) .ne. 0.)) .or.
     +        ((idline .eq. 12) .and. (entry(5) .ne. 0.))) then
              nod1=int(entry(2))
              nod2=int(entry(3))
              lbanwd=3*(1+abs(nod1-nod2))
              if (lbanwd .gt. malhbw) then
                  ierror=6
                  goto 70
              else
                  if (lbanwd .eq. 3) then
                      ierror=7
                      goto 70
                  endif
              endif
              if (idline .eq. 10) then
                  if ((coonod(1,nod1) .eq. coonod(1,nod2)) .and.
     +                (coonod(2,nod1) .eq. coonod(2,nod2))) then
                      ierror=8
                      goto 70
                  endif
              endif
              if (lbanwd .gt. maxban) maxban=lbanwd
          else
              if ((idline .eq. 11) .and. (entry(6) .ne. 0.) .and.
     +            (youngm(int(entry(7))) .ne. 0.)) then
                  maxnod=max(int(entry(2)),int(entry(3)),
     +                        int(entry(4)))
                  minnod=min(int(entry(2)),int(entry(3)),
     +                        int(entry(4)))
                  if (entry(5) .ne. 0.) then
                      maxnod=max(maxnod,int(entry(5)))
                      minnod=min(minnod,int(entry(5)))
                  endif
                  lbanwd=3*(1+maxnod-minnod)
                  if (lbanwd .gt. malhbw) then
                      ierror=6
                      goto 70
                  endif
                  do 65 itcons=2,4
                  nod1=int(entry(itcons))
                  startp=itcons+1
                  do 65 index=startp,5
                  nod2=int(entry(index))
                  if (nod2 .ne. 0) then
                      if (nod1 .eq. nod2) then
                          ierror=7
                          goto 70
                      else
                          if ((coonod(1,nod1) .eq. coonod(1,nod2)) .and.
     +                        (coonod(2,nod1) .eq. coonod(2,nod2))) then
                              ierror=8
                              goto 70
                          endif
                      endif
                  endif
   65             continue
                  if (lbanwd .gt. maxban) maxban=lbanwd
              endif
          endif
          goto 3000
      ELSE
          goto 30
      endif
   70 txtpar(1)='number of nodes in the model                     '
      txtpar(2)='number of types of materials in the model        '
      txtpar(3)='number of beams in the model                     '
      txtpar(4)='number of plates in the model                    '
      txtpar(5)='number of fasteners in the model                 '
      txtpar(6)='number of loaded nodes in the model              '
      txtpar(7)='number of restrained displacements in the model  '
      txtpar(8)='node number                                      '
      txtpar(9)='x coordinate of the node                         '
      txtpar(10)='y coordinate of the node                         '
      txtpar(11)='material number                                  '
      txtpar(12)='Young''s modulus of the material                 '
      txtpar(13)='Poisson''s ratio of the material                 '
      txtpar(14)='beam number                                      '
      txtpar(15)='index of the first node of the beam              '
      txtpar(16)='index of the second node of the beam             '
      txtpar(17)='beam area                                        '
      txtpar(18)='beam moment of inertia                           '
      txtpar(19)='beam material code                               '
      txtpar(20)='distributed load at the first node of the beam   '
      txtpar(21)='distributed load at the second node of the beam  '
      txtpar(22)='plate number                                     '
      txtpar(23)='index of the first node of the plate             '
      txtpar(24)='index of the second node of the plate            '
      txtpar(25)='index of the third node of the plate             '
      txtpar(26)='index of the fourth node of the plate            '
      txtpar(27)='plate thickness                                  '
      txtpar(28)='plate material code                              '
      txtpar(29)='fastener number                                  '
      txtpar(30)='index of the first node of the fastener          '
      txtpar(31)='index of the second node of the fastener         '
      txtpar(32)='fastener area                                    '
      txtpar(33)='fastener stiffness                               '
      txtpar(34)='loaded node number                               '
      txtpar(35)='applied load at the node along the x direction   '
      txtpar(36)='applied load at the node along the y direction   '
      txtpar(37)='applied moment at the node along the z direction '
      txtpar(38)='node number with a restrained degree of freedom  '
      txtpar(39)='restrained degree of freedom of the node         '
      txtpar(40)='imposed displacement at the node                 '
      write (*,80) errmsg(ierror)
   80 FORMAT (//' ERROR : ',A50)
      call diskroom (67)
      write (2,80,err=2000) errmsg(ierror)
      messge(1)='
     +                         '
      messge(2)='
     +                         '
      messge(3)='
     +                         '
      call setstr (240,MESSGE(1))
      stcons='Encountered              '
      call movstr (messge(1),1,1,stcons,1,11)
      IF (ierror .eq. 1) THEN
          stcons=' attempting to read      '
      ELSE
          stcons=' in                      '
      endif
      call setstr (25,stcons)
      call constr (messge(1),stcons)
      call pakstr (messge(1))
      stcons=' line                    '
      call setstr (6,stcons)
      call constr (messge(1),stcons)
      call pakstr (messge(1))
      call constr (messge(1),space)
      call wrfstr (float(linumb),stcons)
      call constr (messge(1),stcons)
      call pakstr (messge(1))
      stcons=' of file                 '
      call setstr (9,stcons)
      call constr (messge(1),stcons)
      call constr (messge(1),space)
      call setstr (78,inpfil)
      call pakstr (inpfil)
      call constr (messge(1),inpfil)
      period='. '
      call setstr (2,period)
      call constr (messge(1),period)
      call writxt (messge)
      IF (ierror .eq. 1) goto 3000
      grafch=char(218)
      call setstr (79,line)
      call filstr (196,line)
      call movstr (line,1,0,grafch,1,1)
      if (chrerr .ne. 0) then
          grafch=char(25)
          call movstr (line,chrerr+1,0,grafch,1,1)
      endif
      length=lenstr (buffer)+2
      grafch=char(191)
      call movstr (line,length,0,grafch,1,1)
      length=length+1
      call endstr (length,line)
      call resstr (line)
      write (*,90) line
   90 format (1x,A79)
      call diskroom (82)
      write (2,90,err=2000) line
      length=length-3
      call setstr (79,line)
      grafch=char(179)
      call movstr (line,1,0,grafch,1,1)
      call movstr (line,2,0,buffer,1,length)
      length=length+2
      call movstr (line,length,0,grafch,1,1)
      length=length+1
      call endstr (length,line)
      call resstr (line)
      write (*,90) line
      call diskroom (82)
      write (2,90,err=2000) line
      grafch=char(192)
      call setstr (79,line)
      call filstr (196,line)
      call movstr (line,1,0,grafch,1,1)
      if (chrerr .ne. 0) then
          grafch=char(24)
          call movstr (line,chrerr+1,0,grafch,1,1)
      endif
      length=lenstr (buffer)+2
      grafch=char(217)
      call movstr (line,length,0,grafch,1,1)
      length=length+1
      call endstr (length,line)
      call resstr (line)
      write (*,90) line
      call diskroom (82)
      write (2,90,err=2000) line
      call filstr (32,messge(1))
      if (ierror .eq. 6) then
          stcons=' The bandwidth for       '
          call movstr (messge(1),1,0,stcons,1,18)
          call movstr (messge(1),20,0,lintyp(idline),1,16)
          call pakstr (messge(1))
          call constr (messge(1),space)
          call wrfstr (entry(1),stcons)
          call constr (messge(1),stcons)
          stcons=' is                      '
          call setstr (4,stcons)
          call constr (messge(1),stcons)
          call constr (messge(1),space)
          call wrfstr (float(lbanwd),stcons)
          call constr (messge(1),stcons)
          stcons=' and exceeds the maximum '
          call setstr (25,stcons)
          call constr (messge(1),stcons)
          stcons=' allowed bandwidth of    '
          call setstr (22,stcons)
          call constr (messge(1),stcons)
          call constr (messge(1),space)
          call wrfstr (float(malhbw),stcons)
          call constr (messge(1),stcons)
          call constr (messge(1),period)
          call writxt (messge)
          goto 3000
      endif
      if (ierror .eq. 7) then
          stcons=' There are identical node'
          call movstr (messge(1),1,0,stcons,1,25)
          call pakstr (messge(1))
          stcons='s in                     '
          call setstr (5,stcons)
          call constr (messge(1),stcons)
          call constr (messge(1),space)
          call setstr (16,lintyp(idline))
          call constr (messge(1),lintyp(idline))
          call resstr (lintyp(idline))
          call pakstr (messge(1))
          call constr (messge(1),space)
          call wrfstr (entry(1),stcons)
          call constr (messge(1),stcons)
          call constr (messge(1),period)
          call writxt (messge)
          goto 3000
      endif
      if (ierror .eq. 8) then
          stcons=' Nodes                   '
          call movstr (messge(1),1,0,stcons,1,6)
          call pakstr (messge(1))
          call constr (messge(1),space)
          call wrfstr (float(nod1),stcons)
          call constr (messge(1),stcons)
          stcons=' and                     '
          call setstr (5,stcons)
          call constr (messge(1),stcons)
          call constr (messge(1),space)
          call wrfstr (float(nod2),stcons)
          call constr (messge(1),stcons)
          stcons=' of                      '
          call setstr (5,stcons)
          call constr (messge(1),stcons)
          call setstr (16,lintyp(idline))
          call constr (messge(1),lintyp(idline))
          call resstr (lintyp(idline))
          call pakstr (messge(1))
          call constr (messge(1),space)
          call wrfstr (entry(1),stcons)
          call constr (messge(1),stcons)
          stcons=' have the same coordinat '
          call setstr (25,stcons)
          call constr (messge(1),stcons)
          stcons='es.                      '
          call setstr (4,stcons)
          call constr (messge(1),stcons)
          call writxt (messge)
          goto 3000
      endif
      if (ierror .eq. 9) then
          stcons=' The                     '
          call movstr (messge(1),1,0,stcons,1,5)
          call pakstr (messge(1))
          call constr (messge(1),space)
          call setstr (30,linent(idline))
          call constr (messge(1),linent(idline))
          call resstr (linent(idline))
          call pakstr (messge(1))
          call constr (messge(1),space)
          call wrfstr (entry(1),stcons)
          call constr (messge(1),stcons)
          stcons=' appear twice.           '
          call setstr (15,stcons)
          call constr (messge(1),stcons)
          call writxt (messge)
          goto 3000
      endif
      stcons=' Reading                 '
      call movstr (messge(1),1,0,stcons,1,8)
      if (idparm .eq. 1) then
          call movstr (messge(1),10,0,lintyp(idline),1,16)
          call pakstr (messge(1))
          stcons=' lines                   '
          call setstr (7,stcons)
          call constr (messge(1),stcons)
      else
          call movstr (messge(1),10,0,linent(idline),1,30)
          call pakstr (messge(1))
          call constr (messge(1),space)
          call wrfstr (entry(1),stcons)
          call constr (messge(1),stcons)
      endif
      stcons=' it was expected to find '
      call setstr(25,stcons)
      call constr(messge(1),stcons)
      if ((idparm .eq. 1) .and. (idline .gt. 7)) then
          stcons=' a                       '
      else
          stcons=' the                     '
      endif
      call setstr (5,stcons)
      call constr (messge(1),stcons)
      call pakstr (messge(1))
      call constr (messge(1),space)
      index=itxtpr(idline,idparm)
      call setstr (49,txtpar(index))
      call constr (messge(1),txtpar(index))
      call resstr (txtpar(index))
      call pakstr (messge(1))
      index=itypar(idline,idparm)
      call setstr (14,typpar(index))
      call constr (messge(1),typpar(index))
      call resstr (typpar(index))
      call pakstr (messge(1))
      stcons=' between                 '
      call setstr (10,stcons)
      call constr (messge(1),stcons)
      call wrfstr (boulow(idline,idparm),stcons)
      call constr (messge(1),stcons)
      stcons=' and                     '
      call setstr (6,stcons)
      call constr (messge(1),stcons)
      call wrfstr (bouhig(idline,idparm),stcons)
      call constr (messge(1),stcons)
      stcons=' - as the                '
      call setstr (11,stcons)
      call constr (messge(1),stcons)
      call setstr (8,ordinl(idparm))
      call constr (messge(1),ordinl(idparm))
      call resstr (ordinl(idparm))
      call pakstr (messge(1))
      stcons=' entry.                  '
      call setstr (8,stcons)
      call constr (messge(1),stcons)
      call writxt (messge)
      goto 3000
 1000 write (*,1010)
 1010 format (//' ERROR : CANNOT READ INPUT FILE.'/
     +          ' The program cannot continue.')
      ierror=-1
      goto 3000
 2000 write (*,2010)
 2010 format (//' ERROR : CANNOT WRITE OUTPUT FILE.'/
     +          ' The program cannot continue.')
      ierror=-1
 3000 return
      end
$PAGE
      SUBROUTINE writxt (messge)
C
C  Write text on the screen formatting to avoid breaking words
C
      IMPLICIT INTEGER (a-z)
      CHARACTER messge*80,line*79,endwrd*3,space*2
      DIMENSION messge(3)
      line='
     +                   '
      call setstr (79,line)
      endwrd='   '
      call setstr (3,endwrd)
      space='  '
      call setstr (2,space)
      call expstr (messge(1))
      startp=1
      endtxt=locstr (1,messge(1),endwrd)
  110 index=startp+79
      IF (ENDTXT .ge. index) THEN
          spcpos=startp-1
  120     nxtspc=spcpos+1
          length=locstr (nxtspc,messge(1),space)
          IF (length .lt. index) THEN
              spcpos=length
              GOTO 120
          endif
          length=spcpos-startp
          call movstr (line,1,1,messge(1),startp,length)
          call resstr (line)
          write (*,90) line
   90     format (1x,A79)
          call diskroom (82)
          write (2,90,err=2000) line
          call setstr (79,line)
          startp=spcpos+1
          GOTO 110
      endif
      endtxt=endtxt-1
      call movstr (line,1,1,messge(1),startp,ENDTXT)
      call resstr (line)
      write (*,90) line
      call diskroom (82)
      write (2,90,err=2000) line
      goto 3000
 2000 write (*,2010)
 2010 format (//' ERROR : CANNOT WRITE OUTPUT FILE.'/
     +          ' The program cannot continue.')
      ierror=-1
 3000 return
      end
$PAGE
      FUNCTION degree (oppsid,closid)
C
C  Determine angle in degrees with opposite and next side of triangle.
C
      IF (abs(closid) .gt. 1e-19) THEN
          degree=57.2957795*ATAN(oppsid/closid)
          IF (closid .LT. 0.) degree=degree+180.
          IF (degree .gt. 180.) degree=degree-360.
      ELSE
          IF (oppsid .ge. 0.) then
              degree=90.
          else
              degree=-90.
          endif
      ENDIF
      RETURN
      END
$PAGE
      SUBROUTINE datstr(string)
C
C  Write the date in a string.
C
      IMPLICIT integer (a-z)
      CHARACTER string*11,blank*2,buffer*10
      call date (day,month,year)
      write (buffer,10) month,day,year
   10 FORMAT (i2,'/',i2,'/',i4)
      READ (buffer,20) string
   20 format (a10)
      call setstr (11,string)
      asciic=ascstr(4,string)
      if (asciic .eq. 32) call modstr (string,4,48)
      RETURN
      END
$PAGE
      SUBROUTINE timstr(string)
C
C  Write the time-of-day in a string.
C
      IMPLICIT integer (a-z)
      real realsc
      CHARACTER string*12,blank*2,buffer*11
      call time (hour,minute,second,sec100)
      realsc=float(second)+float(sec100)/100.
      write (buffer,10) hour,minute,realsc
   10 FORMAT (i2,':',i2,':',f5.2)
      READ (buffer,20) string
   20 format (a11)
      call setstr (12,string)
      asciic=ascstr(4,string)
      if (asciic .eq. 32) call modstr (string,4,48)
      asciic=ascstr(7,string)
      if (asciic .eq. 32) then
          call modstr (string,7,48)
          asciic=ascstr(8,string)
          if (asciic .eq. 32) call modstr (string,8,48)
      endif
      RETURN
      END
$PAGE
      FUNCTION fltstr (string)
C
C  Calculate the floating point value of a string.
C
      CHARACTER buffer*26,string*25
      write (buffer,*) string
      READ (buffer,10,ERR=300) intstr
   10 format (bn,i25)
      fltstr=float(intstr)
      goto 500
  300 fltstr=0
      READ (buffer,310,ERR=500) fltstr
  310 format (bn,f25.0)
  500 RETURN
      END
$PAGE
      SUBROUTINE wrfstr (real,string)
C
C  Write a real in a string.
C
      implicit integer (a-z)
      real real
      CHARACTER string*25,expnnt*5
      if (real .eq. 0.) then
          string='0                        '
          call setstr (25,string)
          call endstr (2,string)
      else
          if ((abs(real) .ge. 1.e11) .or. (abs(real) .lt. 1.e-5)) then
              write (string,10) real
   10         format (E12.6E2)
              call setstr (25,string)
              call pakstr (string)
              expnnt='E    '
              call setstr (5,expnnt)
              call endstr (2,expnnt)
              l=locstr (1,string,expnnt)
              call movstr (expnnt,1,1,string,l,4)
   30         l=l-1
              if (ascstr(l,string) .eq. 48) goto 30
              call movstr (string,l+1,1,expnnt,1,4)
          else
              write (string,40) real
   40         format (F19.10)
              call setstr (25,string)
              call pakstr (string)
              l=lenstr (string)+1
   50         l=l-1
              if (ascstr(l,string) .eq. 48) goto 50
              if (ascstr(l,string) .eq. 46) l=l-1
              call endstr (l+1,string)
          endif
      endif
      RETURN
      END
